home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Tk / generic / tkText.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-05-31  |  66.1 KB  |  2,233 lines
  1. /* 
  2.  * tkText.c --
  3.  *
  4.  *    This module provides a big chunk of the implementation of
  5.  *    multi-line editable text widgets for Tk.  Among other things,
  6.  *    it provides the Tcl command interfaces to text widgets and
  7.  *    the display code.  The B-tree representation of text is
  8.  *    implemented elsewhere.
  9.  *
  10.  * Copyright (c) 1992-1994 The Regents of the University of California.
  11.  * Copyright (c) 1994-1996 Sun Microsystems, Inc.
  12.  *
  13.  * See the file "license.terms" for information on usage and redistribution
  14.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  15.  *
  16.  * SCCS: @(#) tkText.c 1.90 96/04/13 16:49:59
  17.  */
  18.  
  19. #include "default.h"
  20. #include "tkPort.h"
  21. #include "tkInt.h"
  22.  
  23. #ifdef MAC_TCL
  24. #define Style TkStyle
  25. #define DInfo TkDInfo
  26. #endif
  27.  
  28. #include "tkText.h"
  29.  
  30. /*
  31.  * Information used to parse text configuration options:
  32.  */
  33.  
  34. static Tk_ConfigSpec configSpecs[] = {
  35.     {TK_CONFIG_BORDER, "-background", "background", "Background",
  36.     DEF_TEXT_BG_COLOR, Tk_Offset(TkText, border), TK_CONFIG_COLOR_ONLY},
  37.     {TK_CONFIG_BORDER, "-background", "background", "Background",
  38.     DEF_TEXT_BG_MONO, Tk_Offset(TkText, border), TK_CONFIG_MONO_ONLY},
  39.     {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
  40.     (char *) NULL, 0, 0},
  41.     {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
  42.     (char *) NULL, 0, 0},
  43.     {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
  44.     DEF_TEXT_BORDER_WIDTH, Tk_Offset(TkText, borderWidth), 0},
  45.     {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
  46.     DEF_TEXT_CURSOR, Tk_Offset(TkText, cursor), TK_CONFIG_NULL_OK},
  47.     {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
  48.     "ExportSelection", DEF_TEXT_EXPORT_SELECTION,
  49.     Tk_Offset(TkText, exportSelection), 0},
  50.     {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
  51.     (char *) NULL, 0, 0},
  52.     {TK_CONFIG_FONT, "-font", "font", "Font",
  53.     DEF_TEXT_FONT, Tk_Offset(TkText, fontPtr), 0},
  54.     {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
  55.     DEF_TEXT_FG, Tk_Offset(TkText, fgColor), 0},
  56.     {TK_CONFIG_PIXELS, "-height", "height", "Height",
  57.     DEF_TEXT_HEIGHT, Tk_Offset(TkText, height), 0},
  58.     {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
  59.     "HighlightBackground", DEF_TEXT_HIGHLIGHT_BG,
  60.     Tk_Offset(TkText, highlightBgColorPtr), 0},
  61.     {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
  62.     DEF_TEXT_HIGHLIGHT, Tk_Offset(TkText, highlightColorPtr), 0},
  63.     {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
  64.     "HighlightThickness",
  65.     DEF_TEXT_HIGHLIGHT_WIDTH, Tk_Offset(TkText, highlightWidth), 0},
  66.     {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
  67.     DEF_TEXT_INSERT_BG, Tk_Offset(TkText, insertBorder), 0},
  68.     {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
  69.     DEF_TEXT_INSERT_BD_COLOR, Tk_Offset(TkText, insertBorderWidth),
  70.     TK_CONFIG_COLOR_ONLY},
  71.     {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
  72.     DEF_TEXT_INSERT_BD_MONO, Tk_Offset(TkText, insertBorderWidth),
  73.     TK_CONFIG_MONO_ONLY},
  74.     {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
  75.     DEF_TEXT_INSERT_OFF_TIME, Tk_Offset(TkText, insertOffTime), 0},
  76.     {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
  77.     DEF_TEXT_INSERT_ON_TIME, Tk_Offset(TkText, insertOnTime), 0},
  78.     {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
  79.     DEF_TEXT_INSERT_WIDTH, Tk_Offset(TkText, insertWidth), 0},
  80.     {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
  81.     DEF_TEXT_PADX, Tk_Offset(TkText, padX), 0},
  82.     {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
  83.     DEF_TEXT_PADY, Tk_Offset(TkText, padY), 0},
  84.     {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
  85.     DEF_TEXT_RELIEF, Tk_Offset(TkText, relief), 0},
  86.     {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
  87.     DEF_TEXT_SELECT_COLOR, Tk_Offset(TkText, selBorder),
  88.     TK_CONFIG_COLOR_ONLY},
  89.     {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
  90.     DEF_TEXT_SELECT_MONO, Tk_Offset(TkText, selBorder),
  91.     TK_CONFIG_MONO_ONLY},
  92.     {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
  93.     DEF_TEXT_SELECT_BD_COLOR, Tk_Offset(TkText, selBdString),
  94.     TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
  95.     {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
  96.     DEF_TEXT_SELECT_BD_MONO, Tk_Offset(TkText, selBdString),
  97.     TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
  98.     {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
  99.     DEF_TEXT_SELECT_FG_COLOR, Tk_Offset(TkText, selFgColorPtr),
  100.     TK_CONFIG_COLOR_ONLY},
  101.     {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
  102.     DEF_TEXT_SELECT_FG_MONO, Tk_Offset(TkText, selFgColorPtr),
  103.     TK_CONFIG_MONO_ONLY},
  104.     {TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
  105.     DEF_TEXT_SET_GRID, Tk_Offset(TkText, setGrid), 0},
  106.     {TK_CONFIG_PIXELS, "-spacing1", "spacing1", "Spacing",
  107.     DEF_TEXT_SPACING1, Tk_Offset(TkText, spacing1),
  108.     TK_CONFIG_DONT_SET_DEFAULT},
  109.     {TK_CONFIG_PIXELS, "-spacing2", "spacing2", "Spacing",
  110.     DEF_TEXT_SPACING2, Tk_Offset(TkText, spacing2),
  111.     TK_CONFIG_DONT_SET_DEFAULT},
  112.     {TK_CONFIG_PIXELS, "-spacing3", "spacing3", "Spacing",
  113.     DEF_TEXT_SPACING3, Tk_Offset(TkText, spacing3),
  114.     TK_CONFIG_DONT_SET_DEFAULT},
  115.     {TK_CONFIG_UID, "-state", "state", "State",
  116.     DEF_TEXT_STATE, Tk_Offset(TkText, state), 0},
  117.     {TK_CONFIG_STRING, "-tabs", "tabs", "Tabs",
  118.     DEF_TEXT_TABS, Tk_Offset(TkText, tabOptionString), TK_CONFIG_NULL_OK},
  119. #ifdef STk_CODE
  120.     {TK_CONFIG_CLOSURE, "-takefocus", "takeFocus", "TakeFocus",
  121. #else
  122.     {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
  123. #endif
  124.     DEF_TEXT_TAKE_FOCUS, Tk_Offset(TkText, takeFocus),
  125.     TK_CONFIG_NULL_OK},
  126.     {TK_CONFIG_INT, "-width", "width", "Width",
  127.     DEF_TEXT_WIDTH, Tk_Offset(TkText, width), 0},
  128.     {TK_CONFIG_UID, "-wrap", "wrap", "Wrap",
  129.     DEF_TEXT_WRAP, Tk_Offset(TkText, wrapMode), 0},
  130. #ifdef STk_CODE
  131.     {TK_CONFIG_CLOSURE, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
  132. #else
  133.     {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
  134. #endif
  135.     DEF_TEXT_XSCROLL_COMMAND, Tk_Offset(TkText, xScrollCmd),
  136.     TK_CONFIG_NULL_OK},
  137. #ifdef STk_CODE
  138.     {TK_CONFIG_CLOSURE, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
  139. #else
  140.     {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
  141. #endif
  142.     DEF_TEXT_YSCROLL_COMMAND, Tk_Offset(TkText, yScrollCmd),
  143.     TK_CONFIG_NULL_OK},
  144.     {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
  145.     (char *) NULL, 0, 0}
  146. };
  147.  
  148. /*
  149.  * Tk_Uid's used to represent text states:
  150.  */
  151.  
  152. Tk_Uid tkTextCharUid = NULL;
  153. Tk_Uid tkTextDisabledUid = NULL;
  154. Tk_Uid tkTextNoneUid = NULL;
  155. Tk_Uid tkTextNormalUid = NULL;
  156. Tk_Uid tkTextWordUid = NULL;
  157.  
  158. /*
  159.  * Boolean variable indicating whether or not special debugging code
  160.  * should be executed.
  161.  */
  162.  
  163. int tkTextDebug = 0;
  164.  
  165. /*
  166.  * Forward declarations for procedures defined later in this file:
  167.  */
  168.  
  169. static int        ConfigureText _ANSI_ARGS_((Tcl_Interp *interp,
  170.                 TkText *textPtr, int argc, char **argv, int flags));
  171. static int        DeleteChars _ANSI_ARGS_((TkText *textPtr,
  172.                 char *index1String, char *index2String));
  173. static void        DestroyText _ANSI_ARGS_((char *memPtr));
  174. static void        InsertChars _ANSI_ARGS_((TkText *textPtr,
  175.                 TkTextIndex *indexPtr, char *string));
  176. static void        TextBlinkProc _ANSI_ARGS_((ClientData clientData));
  177. static void        TextCmdDeletedProc _ANSI_ARGS_((
  178.                 ClientData clientData));
  179. static void        TextEventProc _ANSI_ARGS_((ClientData clientData,
  180.                 XEvent *eventPtr));
  181. static int        TextFetchSelection _ANSI_ARGS_((ClientData clientData,
  182.                 int offset, char *buffer, int maxBytes));
  183. static int        TextSearchCmd _ANSI_ARGS_((TkText *textPtr,
  184.                 Tcl_Interp *interp, int argc, char **argv));
  185. static int        TextWidgetCmd _ANSI_ARGS_((ClientData clientData,
  186.                 Tcl_Interp *interp, int argc, char **argv));
  187. static int        TextDumpCmd _ANSI_ARGS_((TkText *textPtr,
  188.                 Tcl_Interp *interp, int argc, char **argv));
  189. static void        DumpLine _ANSI_ARGS_((Tcl_Interp *interp, 
  190.                 TkText *textPtr, int what, TkTextLine *linePtr,
  191.                 int start, int end, int lineno, char *command));
  192. static int        DumpSegment _ANSI_ARGS_((Tcl_Interp *interp, char *key,
  193.                 char *value, char * command, int lineno, int offset,
  194.                 int what));
  195.  
  196.  
  197. /*
  198.  *--------------------------------------------------------------
  199.  *
  200.  * Tk_TextCmd --
  201.  *
  202.  *    This procedure is invoked to process the "text" Tcl command.
  203.  *    See the user documentation for details on what it does.
  204.  *
  205.  * Results:
  206.  *    A standard Tcl result.
  207.  *
  208.  * Side effects:
  209.  *    See the user documentation.
  210.  *
  211.  *--------------------------------------------------------------
  212.  */
  213.  
  214. int
  215. Tk_TextCmd(clientData, interp, argc, argv)
  216.     ClientData clientData;    /* Main window associated with
  217.                  * interpreter. */
  218.     Tcl_Interp *interp;        /* Current interpreter. */
  219.     int argc;            /* Number of arguments. */
  220.     char **argv;        /* Argument strings. */
  221. {
  222.     Tk_Window tkwin = (Tk_Window) clientData;
  223.     Tk_Window new;
  224.     register TkText *textPtr;
  225.     TkTextIndex startIndex;
  226.  
  227.     if (argc < 2) {
  228.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  229.         argv[0], " pathName ?options?\"", (char *) NULL);
  230.     return TCL_ERROR;
  231.     }
  232.  
  233.     /*
  234.      * Perform once-only initialization:
  235.      */
  236.  
  237.     if (tkTextNormalUid == NULL) {
  238.     tkTextCharUid = Tk_GetUid("char");
  239.     tkTextDisabledUid = Tk_GetUid("disabled");
  240.     tkTextNoneUid = Tk_GetUid("none");
  241.     tkTextNormalUid = Tk_GetUid("normal");
  242.     tkTextWordUid = Tk_GetUid("word");
  243.     }
  244.  
  245.     /*
  246.      * Create the window.
  247.      */
  248.  
  249.     new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
  250.     if (new == NULL) {
  251.     return TCL_ERROR;
  252.     }
  253.  
  254.     textPtr = (TkText *) ckalloc(sizeof(TkText));
  255.     textPtr->tkwin = new;
  256.     textPtr->display = Tk_Display(new);
  257.     textPtr->interp = interp;
  258.     textPtr->widgetCmd = Tcl_CreateCommand(interp,
  259.         Tk_PathName(textPtr->tkwin), TextWidgetCmd,
  260.         (ClientData) textPtr, TextCmdDeletedProc);
  261.     textPtr->tree = TkBTreeCreate(textPtr);
  262.     Tcl_InitHashTable(&textPtr->tagTable, TCL_STRING_KEYS);
  263.     textPtr->numTags = 0;
  264.     Tcl_InitHashTable(&textPtr->markTable, TCL_STRING_KEYS);
  265.     Tcl_InitHashTable(&textPtr->windowTable, TCL_STRING_KEYS);
  266.     textPtr->state = tkTextNormalUid;
  267.     textPtr->border = NULL;
  268.     textPtr->borderWidth = 0;
  269.     textPtr->padX = 0;
  270.     textPtr->padY = 0;
  271.     textPtr->relief = TK_RELIEF_FLAT;
  272.     textPtr->highlightWidth = 0;
  273.     textPtr->highlightBgColorPtr = NULL;
  274.     textPtr->highlightColorPtr = NULL;
  275.     textPtr->cursor = None;
  276.     textPtr->fgColor = NULL;
  277.     textPtr->fontPtr = NULL;
  278.     textPtr->charWidth = 1;
  279.     textPtr->spacing1 = 0;
  280.     textPtr->spacing2 = 0;
  281.     textPtr->spacing3 = 0;
  282.     textPtr->tabOptionString = NULL;
  283.     textPtr->tabArrayPtr = NULL;
  284.     textPtr->wrapMode = tkTextCharUid;
  285.     textPtr->width = 0;
  286.     textPtr->height = 0;
  287.     textPtr->setGrid = 0;
  288.     textPtr->prevWidth = Tk_Width(new);
  289.     textPtr->prevHeight = Tk_Height(new);
  290.     TkTextCreateDInfo(textPtr);
  291.     TkTextMakeIndex(textPtr->tree, 0, 0, &startIndex);
  292.     TkTextSetYView(textPtr, &startIndex, 0);
  293.     textPtr->selTagPtr = NULL;
  294.     textPtr->selBorder = NULL;
  295.     textPtr->selBdString = NULL;
  296.     textPtr->selFgColorPtr = NULL;
  297.     textPtr->exportSelection = 1;
  298.     textPtr->abortSelections = 0;
  299.     textPtr->insertMarkPtr = NULL;
  300.     textPtr->insertBorder = NULL;
  301.     textPtr->insertWidth = 0;
  302.     textPtr->insertBorderWidth = 0;
  303.     textPtr->insertOnTime = 0;
  304.     textPtr->insertOffTime = 0;
  305.     textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
  306.     textPtr->bindingTable = NULL;
  307.     textPtr->currentMarkPtr = NULL;
  308.     textPtr->pickEvent.type = LeaveNotify;
  309.     textPtr->pickEvent.xcrossing.x = 0;
  310.     textPtr->pickEvent.xcrossing.y = 0;
  311.     textPtr->numCurTags = 0;
  312.     textPtr->curTagArrayPtr = NULL;
  313.     textPtr->takeFocus = NULL;
  314.     textPtr->xScrollCmd = NULL;
  315.     textPtr->yScrollCmd = NULL;
  316.     textPtr->flags = 0;
  317.  
  318.     /*
  319.      * Create the "sel" tag and the "current" and "insert" marks.
  320.      */
  321.  
  322.     textPtr->selTagPtr = TkTextCreateTag(textPtr, "sel");
  323.     textPtr->selTagPtr->reliefString = (char *) ckalloc(7);
  324.     strcpy(textPtr->selTagPtr->reliefString, "raised");
  325.     textPtr->selTagPtr->relief = TK_RELIEF_RAISED;
  326.     textPtr->currentMarkPtr = TkTextSetMark(textPtr, "current", &startIndex);
  327.     textPtr->insertMarkPtr = TkTextSetMark(textPtr, "insert", &startIndex);
  328.  
  329.     Tk_SetClass(new, "Text");
  330.     Tk_CreateEventHandler(textPtr->tkwin,
  331.         ExposureMask|StructureNotifyMask|FocusChangeMask,
  332.         TextEventProc, (ClientData) textPtr);
  333.     Tk_CreateEventHandler(textPtr->tkwin, KeyPressMask|KeyReleaseMask
  334.         |ButtonPressMask|ButtonReleaseMask|EnterWindowMask
  335.         |LeaveWindowMask|PointerMotionMask, TkTextBindProc,
  336.         (ClientData) textPtr);
  337.     Tk_CreateSelHandler(textPtr->tkwin, XA_PRIMARY, XA_STRING,
  338.         TextFetchSelection, (ClientData) textPtr, XA_STRING);
  339.     if (ConfigureText(interp, textPtr, argc-2, argv+2, 0) != TCL_OK) {
  340.     Tk_DestroyWindow(textPtr->tkwin);
  341.     return TCL_ERROR;
  342.     }
  343. #ifdef STk_CODE
  344.     STk_sharp_dot_result(interp, Tk_PathName(textPtr->tkwin));
  345. #else
  346.     interp->result = Tk_PathName(textPtr->tkwin);
  347. #endif
  348.  
  349.     return TCL_OK;
  350. }
  351.  
  352. /*
  353.  *--------------------------------------------------------------
  354.  *
  355.  * TextWidgetCmd --
  356.  *
  357.  *    This procedure is invoked to process the Tcl command
  358.  *    that corresponds to a text widget.  See the user
  359.  *    documentation for details on what it does.
  360.  *
  361.  * Results:
  362.  *    A standard Tcl result.
  363.  *
  364.  * Side effects:
  365.  *    See the user documentation.
  366.  *
  367.  *--------------------------------------------------------------
  368.  */
  369.  
  370. static int
  371. TextWidgetCmd(clientData, interp, argc, argv)
  372.     ClientData clientData;    /* Information about text widget. */
  373.     Tcl_Interp *interp;        /* Current interpreter. */
  374.     int argc;            /* Number of arguments. */
  375.     char **argv;        /* Argument strings. */
  376. {
  377.     register TkText *textPtr = (TkText *) clientData;
  378.     int result = TCL_OK;
  379.     size_t length;
  380.     int c;
  381.     TkTextIndex index1, index2;
  382.  
  383.     if (argc < 2) {
  384.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  385.         argv[0], " option ?arg arg ...?\"", (char *) NULL);
  386.     return TCL_ERROR;
  387.     }
  388.     Tcl_Preserve((ClientData) textPtr);
  389.     c = argv[1][0];
  390.     length = strlen(argv[1]);
  391.     if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
  392.     int x, y, width, height;
  393.  
  394.     if (argc != 3) {
  395.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  396.             argv[0], " bbox index\"", (char *) NULL);
  397.         result = TCL_ERROR;
  398.         goto done;
  399.     }
  400.     if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
  401.         result = TCL_ERROR;
  402.         goto done;
  403.     }
  404.     if (TkTextCharBbox(textPtr, &index1, &x, &y, &width, &height) == 0) {
  405.         sprintf(interp->result, "%d %d %d %d", x, y, width, height);
  406.     }
  407.     } else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)
  408.         && (length >= 2)) {
  409.     if (argc != 3) {
  410.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  411.             argv[0], " cget option\"",
  412.             (char *) NULL);
  413.         result = TCL_ERROR;
  414.         goto done;
  415.     }
  416.     result = Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs,
  417.         (char *) textPtr, argv[2], 0);
  418.     } else if ((c == 'c') && (strncmp(argv[1], "compare", length) == 0)
  419.         && (length >= 3)) {
  420.     int relation, value;
  421.     char *p;
  422.  
  423.     if (argc != 5) {
  424.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  425.             argv[0], " compare index1 op index2\"", (char *) NULL);
  426.         result = TCL_ERROR;
  427.         goto done;
  428.     }
  429.     if ((TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK)
  430.         || (TkTextGetIndex(interp, textPtr, argv[4], &index2)
  431.         != TCL_OK)) {
  432.         result = TCL_ERROR;
  433.         goto done;
  434.     }
  435.     relation = TkTextIndexCmp(&index1, &index2);
  436.     p = argv[3];
  437.     if (p[0] == '<') {
  438.         value = (relation < 0);
  439.         if ((p[1] == '=') && (p[2] == 0)) {
  440.         value = (relation <= 0);
  441.         } else if (p[1] != 0) {
  442.         compareError:
  443.         Tcl_AppendResult(interp, "bad comparison operator \"",
  444.             argv[3], "\": must be <, <=, ==, >=, >, or !=",
  445.             (char *) NULL);
  446.         result = TCL_ERROR;
  447.         goto done;
  448.         }
  449.     } else if (p[0] == '>') {
  450.         value = (relation > 0);
  451.         if ((p[1] == '=') && (p[2] == 0)) {
  452.         value = (relation >= 0);
  453.         } else if (p[1] != 0) {
  454.         goto compareError;
  455.         }
  456.     } else if ((p[0] == '=') && (p[1] == '=') && (p[2] == 0)) {
  457.         value = (relation == 0);
  458.     } else if ((p[0] == '!') && (p[1] == '=') && (p[2] == 0)) {
  459.         value = (relation != 0);
  460.     } else {
  461.         goto compareError;
  462.     }
  463. #ifdef STk_CODE
  464.     interp->result = (value) ? "#t" : "#f";
  465. #else
  466.     interp->result = (value) ? "1" : "0";
  467. #endif
  468.     } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
  469.         && (length >= 3)) {
  470.     if (argc == 2) {
  471.         result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
  472.             (char *) textPtr, (char *) NULL, 0);
  473.     } else if (argc == 3) {
  474.         result = Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
  475.             (char *) textPtr, argv[2], 0);
  476.     } else {
  477.         result = ConfigureText(interp, textPtr, argc-2, argv+2,
  478.             TK_CONFIG_ARGV_ONLY);
  479.     }
  480.     } else if ((c == 'd') && (strncmp(argv[1], "debug", length) == 0)
  481.         && (length >= 3)) {
  482.     if (argc > 3) {
  483.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  484.             argv[0], " debug boolean\"", (char *) NULL);
  485.         result = TCL_ERROR;
  486.         goto done;
  487.     }
  488.     if (argc == 2) {
  489. #ifdef STk_CODE
  490.         interp->result = (tkBTreeDebug) ? "#t" : "#f";
  491. #else
  492.         interp->result = (tkBTreeDebug) ? "1" : "0";
  493. #endif
  494.     } else {
  495.         if (Tcl_GetBoolean(interp, argv[2], &tkBTreeDebug) != TCL_OK) {
  496.         result = TCL_ERROR;
  497.         goto done;
  498.         }
  499.         tkTextDebug = tkBTreeDebug;
  500.     }
  501.     } else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)
  502.         && (length >= 3)) {
  503.     if ((argc != 3) && (argc != 4)) {
  504.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  505.             argv[0], " delete index1 ?index2?\"", (char *) NULL);
  506.         result = TCL_ERROR;
  507.         goto done;
  508.     }
  509.     if (textPtr->state == tkTextNormalUid) {
  510.         result = DeleteChars(textPtr, argv[2],
  511.             (argc == 4) ? argv[3] : (char *) NULL);
  512.     }
  513.     } else if ((c == 'd') && (strncmp(argv[1], "dlineinfo", length) == 0)
  514.         && (length >= 2)) {
  515.     int x, y, width, height, base;
  516.  
  517.     if (argc != 3) {
  518.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  519.             argv[0], " dlineinfo index\"", (char *) NULL);
  520.         result = TCL_ERROR;
  521.         goto done;
  522.     }
  523.     if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
  524.         result = TCL_ERROR;
  525.         goto done;
  526.     }
  527.     if (TkTextDLineInfo(textPtr, &index1, &x, &y, &width, &height, &base)
  528.         == 0) {
  529.         sprintf(interp->result, "%d %d %d %d %d", x, y, width,
  530.             height, base);
  531.     }
  532.     } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
  533.     if ((argc != 3) && (argc != 4)) {
  534.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  535.             argv[0], " get index1 ?index2?\"", (char *) NULL);
  536.         result = TCL_ERROR;
  537.         goto done;
  538.     }
  539.     if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
  540.         result = TCL_ERROR;
  541.         goto done;
  542.     }
  543.     if (argc == 3) {
  544.         index2 = index1;
  545.         TkTextIndexForwChars(&index2, 1, &index2);
  546.     } else if (TkTextGetIndex(interp, textPtr, argv[3], &index2)
  547.         != TCL_OK) {
  548.         result = TCL_ERROR;
  549.         goto done;
  550.     }
  551.     if (TkTextIndexCmp(&index1, &index2) >= 0) {
  552. #ifdef STk_CODE
  553.         interp->result = "\"\"";
  554. #endif
  555.         goto done;
  556.     }
  557.     while (1) {
  558.         int offset, last, savedChar;
  559.         TkTextSegment *segPtr;
  560.  
  561.         segPtr = TkTextIndexToSeg(&index1, &offset);
  562.         last = segPtr->size;
  563.         if (index1.linePtr == index2.linePtr) {
  564.         int last2;
  565.  
  566.         if (index2.charIndex == index1.charIndex) {
  567.             break;
  568.         }
  569.         last2 = index2.charIndex - index1.charIndex + offset;
  570.         if (last2 < last) {
  571.             last = last2;
  572.         }
  573.         }
  574.         if (segPtr->typePtr == &tkTextCharType) {
  575.         savedChar = segPtr->body.chars[last];
  576.         segPtr->body.chars[last] = 0;
  577.         Tcl_AppendResult(interp, segPtr->body.chars + offset,
  578.             (char *) NULL);
  579.         segPtr->body.chars[last] = savedChar;
  580.         }
  581.         TkTextIndexForwChars(&index1, last-offset, &index1);
  582.     }
  583. #ifdef STk_CODE
  584.     STk_stringify_result(interp, interp->result);
  585. #endif
  586.     } else if ((c == 'i') && (strncmp(argv[1], "index", length) == 0)
  587.         && (length >= 3)) {
  588.     if (argc != 3) {
  589.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  590.             argv[0], " index index\"",
  591.             (char *) NULL);
  592.         result = TCL_ERROR;
  593.         goto done;
  594.     }
  595.     if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
  596.         result = TCL_ERROR;
  597.         goto done;
  598.     }
  599.     TkTextPrintIndex(&index1, interp->result);
  600.     } else if ((c == 'i') && (strncmp(argv[1], "insert", length) == 0)
  601.         && (length >= 3)) {
  602.     int i, j, numTags;
  603.     char **tagNames;
  604.     TkTextTag **oldTagArrayPtr;
  605.  
  606.     if (argc < 4) {
  607.         Tcl_AppendResult(interp, "wrong # args: should be \"",
  608.             argv[0],
  609.             " insert index chars ?tagList chars tagList ...?\"",
  610.             (char *) NULL);
  611.         result = TCL_ERROR;
  612.         goto done;
  613.     }
  614.     if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
  615.         result = TCL_ERROR;
  616.         goto done;
  617.     }
  618.     if (textPtr->state == tkTextNormalUid) {
  619.         for (j = 3;  j < argc; j += 2) {
  620.         InsertChars(textPtr, &index1, argv[j]);
  621.         if (argc > (j+1)) {
  622.             TkTextIndexForwChars(&index1, (int) strlen(argv[j]),
  623.                 &index2);
  624.             oldTagArrayPtr = TkBTreeGetTags(&index1, &numTags);
  625.             if (oldTagArrayPtr != NULL) {
  626.             for (i = 0; i < numTags; i++) {
  627.                 TkBTreeTag(&index1, &index2, oldTagArrayPtr[i], 0);
  628.             }
  629.             ckfree((char *) oldTagArrayPtr);
  630.             }
  631.             if (Tcl_SplitList(interp, argv[j+1], &numTags, &tagNames)
  632.                 != TCL_OK) {
  633.             result = TCL_ERROR;
  634.             goto done;
  635.             }
  636.             for (i = 0; i < numTags; i++) {
  637.             TkBTreeTag(&index1, &index2,
  638.                 TkTextCreateTag(textPtr, tagNames[i]), 1);
  639.             }
  640.             ckfree((char *) tagNames);
  641.             index1 = index2;
  642.         }
  643.         }
  644.     }
  645.     } else if ((c == 'd') && (strncmp(argv[1], "dump", length) == 0)) {
  646.     result = TextDumpCmd(textPtr, interp, argc, argv);
  647.     } else if ((c == 'm') && (strncmp(argv[1], "mark", length) == 0)) {
  648.     result = TkTextMarkCmd(textPtr, interp, argc, argv);
  649.     } else if ((c == 's') && (strcmp(argv[1], "scan") == 0) && (length >= 2)) {
  650.     result = TkTextScanCmd(textPtr, interp, argc, argv);
  651.     } else if ((c == 's') && (strcmp(argv[1], "search") == 0)
  652.         && (length >= 3)) {
  653.     result = TextSearchCmd(textPtr, interp, argc, argv);
  654.     } else if ((c == 's') && (strcmp(argv[1], "see") == 0) && (length >= 3)) {
  655.     result = TkTextSeeCmd(textPtr, interp, argc, argv);
  656.     } else if ((c == 't') && (strcmp(argv[1], "tag") == 0)) {
  657.     result = TkTextTagCmd(textPtr, interp, argc, argv);
  658.     } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
  659.     result = TkTextWindowCmd(textPtr, interp, argc, argv);
  660.     } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
  661.     result = TkTextXviewCmd(textPtr, interp, argc, argv);
  662.     } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)
  663.         && (length >= 2)) {
  664.     result = TkTextYviewCmd(textPtr, interp, argc, argv);
  665.     } else {
  666.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  667.         "\": must be bbox, cget, compare, configure, debug, delete, ",
  668.         "dlineinfo, get, index, insert, mark, scan, search, see, ",
  669.         "tag, window, xview, or yview",
  670.         (char *) NULL);
  671.     result = TCL_ERROR;
  672.     }
  673.  
  674.     done:
  675.     Tcl_Release((ClientData) textPtr);
  676.     return result;
  677. }
  678.  
  679. /*
  680.  *----------------------------------------------------------------------
  681.  *
  682.  * DestroyText --
  683.  *
  684.  *    This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
  685.  *    to clean up the internal structure of a text at a safe time
  686.  *    (when no-one is using it anymore).
  687.  *
  688.  * Results:
  689.  *    None.
  690.  *
  691.  * Side effects:
  692.  *    Everything associated with the text is freed up.
  693.  *
  694.  *----------------------------------------------------------------------
  695.  */
  696.  
  697. static void
  698. DestroyText(memPtr)
  699.     char *memPtr;        /* Info about text widget. */
  700. {
  701.     register TkText *textPtr = (TkText *) memPtr;
  702.     Tcl_HashSearch search;
  703.     Tcl_HashEntry *hPtr;
  704.     TkTextTag *tagPtr;
  705.  
  706.     /*
  707.      * Free up all the stuff that requires special handling, then
  708.      * let Tk_FreeOptions handle all the standard option-related
  709.      * stuff.  Special note:  free up display-related information
  710.      * before deleting the B-tree, since display-related stuff
  711.      * may refer to stuff in the B-tree.
  712.      */
  713.  
  714.     TkTextFreeDInfo(textPtr);
  715.     TkBTreeDestroy(textPtr->tree);
  716.     for (hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search);
  717.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  718.     tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
  719.     TkTextFreeTag(textPtr, tagPtr);
  720.     }
  721.     Tcl_DeleteHashTable(&textPtr->tagTable);
  722.     for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search);
  723.         hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
  724.     ckfree((char *) Tcl_GetHashValue(hPtr));
  725.     }
  726.     Tcl_DeleteHashTable(&textPtr->markTable);
  727.     if (textPtr->tabArrayPtr != NULL) {
  728.     ckfree((char *) textPtr->tabArrayPtr);
  729.     }
  730.     if (textPtr->insertBlinkHandler != NULL) {
  731.     Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
  732.     }
  733.     if (textPtr->bindingTable != NULL) {
  734.     Tk_DeleteBindingTable(textPtr->bindingTable);
  735.     }
  736.  
  737.     /*
  738.      * NOTE: do NOT free up selBorder, selBdString, or selFgColorPtr:
  739.      * they are duplicates of information in the "sel" tag, which was
  740.      * freed up as part of deleting the tags above.
  741.      */
  742.  
  743.     textPtr->selBorder = NULL;
  744.     textPtr->selBdString = NULL;
  745.     textPtr->selFgColorPtr = NULL;
  746.     Tk_FreeOptions(configSpecs, (char *) textPtr, textPtr->display, 0);
  747.     ckfree((char *) textPtr);
  748. }
  749.  
  750. /*
  751.  *----------------------------------------------------------------------
  752.  *
  753.  * ConfigureText --
  754.  *
  755.  *    This procedure is called to process an argv/argc list, plus
  756.  *    the Tk option database, in order to configure (or
  757.  *    reconfigure) a text widget.
  758.  *
  759.  * Results:
  760.  *    The return value is a standard Tcl result.  If TCL_ERROR is
  761.  *    returned, then interp->result contains an error message.
  762.  *
  763.  * Side effects:
  764.  *    Configuration information, such as text string, colors, font,
  765.  *    etc. get set for textPtr;  old resources get freed, if there
  766.  *    were any.
  767.  *
  768.  *----------------------------------------------------------------------
  769.  */
  770.  
  771. static int
  772. ConfigureText(interp, textPtr, argc, argv, flags)
  773.     Tcl_Interp *interp;        /* Used for error reporting. */
  774.     register TkText *textPtr;    /* Information about widget;  may or may
  775.                  * not already have values for some fields. */
  776.     int argc;            /* Number of valid entries in argv. */
  777.     char **argv;        /* Arguments. */
  778.     int flags;            /* Flags to pass to Tk_ConfigureWidget. */
  779. {
  780.     int oldExport = textPtr->exportSelection;
  781.     int charHeight;
  782.  
  783.     if (Tk_ConfigureWidget(interp, textPtr->tkwin, configSpecs,
  784.         argc, argv, (char *) textPtr, flags) != TCL_OK) {
  785.     return TCL_ERROR;
  786.     }
  787.  
  788.     /*
  789.      * A few other options also need special processing, such as parsing
  790.      * the geometry and setting the background from a 3-D border.
  791.      */
  792.  
  793.     if ((textPtr->state != tkTextNormalUid)
  794.         && (textPtr->state != tkTextDisabledUid)) {
  795.     Tcl_AppendResult(interp, "bad state value \"", textPtr->state,
  796.         "\": must be normal or disabled", (char *) NULL);
  797.     textPtr->state = tkTextNormalUid;
  798.     return TCL_ERROR;
  799.     }
  800.  
  801.     if ((textPtr->wrapMode != tkTextCharUid)
  802.         && (textPtr->wrapMode != tkTextNoneUid)
  803.         && (textPtr->wrapMode != tkTextWordUid)) {
  804.     Tcl_AppendResult(interp, "bad wrap mode \"", textPtr->wrapMode,
  805.         "\": must be char, none, or word", (char *) NULL);
  806.     textPtr->wrapMode = tkTextCharUid;
  807.     return TCL_ERROR;
  808.     }
  809.  
  810.     Tk_SetBackgroundFromBorder(textPtr->tkwin, textPtr->border);
  811.  
  812.     /*
  813.      * Don't allow negative spacings.
  814.      */
  815.  
  816.     if (textPtr->spacing1 < 0) {
  817.     textPtr->spacing1 = 0;
  818.     }
  819.     if (textPtr->spacing2 < 0) {
  820.     textPtr->spacing2 = 0;
  821.     }
  822.     if (textPtr->spacing3 < 0) {
  823.     textPtr->spacing3 = 0;
  824.     }
  825.  
  826.     /*
  827.      * Parse tab stops.
  828.      */
  829.  
  830.     if (textPtr->tabArrayPtr != NULL) {
  831.     ckfree((char *) textPtr->tabArrayPtr);
  832.     textPtr->tabArrayPtr = NULL;
  833.     }
  834.     if (textPtr->tabOptionString != NULL) {
  835.     textPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr->tkwin,
  836.         textPtr->tabOptionString);
  837.     if (textPtr->tabArrayPtr == NULL) {
  838.         Tcl_AddErrorInfo(interp,"\n    (while processing -tabs option)");
  839.         return TCL_ERROR;
  840.     }
  841.     }
  842.  
  843.     /*
  844.      * Make sure that configuration options are properly mirrored
  845.      * between the widget record and the "sel" tags.  NOTE: we don't
  846.      * have to free up information during the mirroring;  old
  847.      * information was freed when it was replaced in the widget
  848.      * record.
  849.      */
  850.  
  851.     textPtr->selTagPtr->border = textPtr->selBorder;
  852.     if (textPtr->selTagPtr->bdString != textPtr->selBdString) {
  853.     textPtr->selTagPtr->bdString = textPtr->selBdString;
  854.     if (textPtr->selBdString != NULL) {
  855.         if (Tk_GetPixels(interp, textPtr->tkwin, textPtr->selBdString,
  856.             &textPtr->selTagPtr->borderWidth) != TCL_OK) {
  857.         return TCL_ERROR;
  858.         }
  859.         if (textPtr->selTagPtr->borderWidth < 0) {
  860.         textPtr->selTagPtr->borderWidth = 0;
  861.         }
  862.     }
  863.     }
  864.     textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr;
  865.     textPtr->selTagPtr->affectsDisplay = 0;
  866.     if ((textPtr->selTagPtr->border != NULL)
  867.         || (textPtr->selTagPtr->bdString != NULL)
  868.         || (textPtr->selTagPtr->reliefString != NULL)
  869.         || (textPtr->selTagPtr->bgStipple != None)
  870.         || (textPtr->selTagPtr->fgColor != NULL)
  871.         || (textPtr->selTagPtr->fontPtr != None)
  872.         || (textPtr->selTagPtr->fgStipple != None)
  873.         || (textPtr->selTagPtr->justifyString != NULL)
  874.         || (textPtr->selTagPtr->lMargin1String != NULL)
  875.         || (textPtr->selTagPtr->lMargin2String != NULL)
  876.         || (textPtr->selTagPtr->offsetString != NULL)
  877.         || (textPtr->selTagPtr->overstrikeString != NULL)
  878.         || (textPtr->selTagPtr->rMarginString != NULL)
  879.         || (textPtr->selTagPtr->spacing1String != NULL)
  880.         || (textPtr->selTagPtr->spacing2String != NULL)
  881.         || (textPtr->selTagPtr->spacing3String != NULL)
  882.         || (textPtr->selTagPtr->tabString != NULL)
  883.         || (textPtr->selTagPtr->underlineString != NULL)
  884.         || (textPtr->selTagPtr->wrapMode != NULL)) {
  885.     textPtr->selTagPtr->affectsDisplay = 1;
  886.     }
  887.     TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL,
  888.         textPtr->selTagPtr, 1);
  889.  
  890.     /*
  891.      * Claim the selection if we've suddenly started exporting it and there
  892.      * are tagged characters.
  893.      */
  894.  
  895.     if (textPtr->exportSelection && (!oldExport)) {
  896.     TkTextSearch search;
  897.     TkTextIndex first, last;
  898.  
  899.     TkTextMakeIndex(textPtr->tree, 0, 0, &first);
  900.     TkTextMakeIndex(textPtr->tree,
  901.         TkBTreeNumLines(textPtr->tree), 0, &last);
  902.     TkBTreeStartSearch(&first, &last, textPtr->selTagPtr, &search);
  903.     if (TkBTreeCharTagged(&first, textPtr->selTagPtr)
  904.         || TkBTreeNextTag(&search)) {
  905.         Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY, TkTextLostSelection,
  906.             (ClientData) textPtr);
  907.         textPtr->flags |= GOT_SELECTION;
  908.     }
  909.     }
  910.  
  911.     /*
  912.      * Register the desired geometry for the window, and arrange for
  913.      * the window to be redisplayed.
  914.      */
  915.  
  916.     if (textPtr->width <= 0) {
  917.     textPtr->width = 1;
  918.     }
  919.     if (textPtr->height <= 0) {
  920.     textPtr->height = 1;
  921.     }
  922.     textPtr->charWidth = XTextWidth(textPtr->fontPtr, "0", 1);
  923.     if (textPtr->charWidth <= 0) {
  924.     textPtr->charWidth = 1;
  925.     }
  926.     charHeight = (textPtr->fontPtr->ascent + textPtr->fontPtr->descent);
  927.     Tk_GeometryRequest(textPtr->tkwin,
  928.         textPtr->width * textPtr->charWidth + 2*textPtr->borderWidth
  929.             + 2*textPtr->padX + 2*textPtr->highlightWidth,
  930.         textPtr->height * charHeight + 2*textPtr->borderWidth
  931.             + 2*textPtr->padY + 2*textPtr->highlightWidth);
  932.     Tk_SetInternalBorder(textPtr->tkwin,
  933.         textPtr->borderWidth + textPtr->highlightWidth);
  934.     if (textPtr->setGrid) {
  935.     Tk_SetGrid(textPtr->tkwin, textPtr->width, textPtr->height,
  936.         textPtr->charWidth, charHeight);
  937.     } else {
  938.     Tk_UnsetGrid(textPtr->tkwin);
  939.     }
  940.  
  941.     TkTextRelayoutWindow(textPtr);
  942.     return TCL_OK;
  943. }
  944.  
  945. /*
  946.  *--------------------------------------------------------------
  947.  *
  948.  * TextEventProc --
  949.  *
  950.  *    This procedure is invoked by the Tk dispatcher on
  951.  *    structure changes to a text.  For texts with 3D
  952.  *    borders, this procedure is also invoked for exposures.
  953.  *
  954.  * Results:
  955.  *    None.
  956.  *
  957.  * Side effects:
  958.  *    When the window gets deleted, internal structures get
  959.  *    cleaned up.  When it gets exposed, it is redisplayed.
  960.  *
  961.  *--------------------------------------------------------------
  962.  */
  963.  
  964. static void
  965. TextEventProc(clientData, eventPtr)
  966.     ClientData clientData;    /* Information about window. */
  967.     register XEvent *eventPtr;    /* Information about event. */
  968. {
  969.     register TkText *textPtr = (TkText *) clientData;
  970.     TkTextIndex index, index2;
  971.  
  972.     if (eventPtr->type == Expose) {
  973.     TkTextRedrawRegion(textPtr, eventPtr->xexpose.x,
  974.         eventPtr->xexpose.y, eventPtr->xexpose.width,
  975.         eventPtr->xexpose.height);
  976.     } else if (eventPtr->type == ConfigureNotify) {
  977.     if ((textPtr->prevWidth != Tk_Width(textPtr->tkwin))
  978.         || (textPtr->prevHeight != Tk_Height(textPtr->tkwin))) {
  979.         TkTextRelayoutWindow(textPtr);
  980.         textPtr->prevWidth = Tk_Width(textPtr->tkwin);
  981.         textPtr->prevHeight = Tk_Height(textPtr->tkwin);
  982.     }
  983.     } else if (eventPtr->type == DestroyNotify) {
  984.     if (textPtr->setGrid) {
  985.         Tk_UnsetGrid(textPtr->tkwin);
  986.     }
  987.     if (textPtr->tkwin != NULL) {
  988.         textPtr->tkwin = NULL;
  989.         Tcl_DeleteCommand(textPtr->interp,
  990.             Tcl_GetCommandName(textPtr->interp,
  991.             textPtr->widgetCmd));
  992.     }
  993.     Tcl_EventuallyFree((ClientData) textPtr, DestroyText);
  994.     } else if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
  995.     if (eventPtr->xfocus.detail != NotifyInferior) {
  996.         Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
  997.         if (eventPtr->type == FocusIn) {
  998.         textPtr->flags |= GOT_FOCUS | INSERT_ON;
  999.         if (textPtr->insertOffTime != 0) {
  1000.             textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
  1001.                 textPtr->insertOnTime, TextBlinkProc,
  1002.                 (ClientData) textPtr);
  1003.         }
  1004.         } else {
  1005.         textPtr->flags &= ~(GOT_FOCUS | INSERT_ON);
  1006.         textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
  1007.         }
  1008.         TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
  1009.         TkTextIndexForwChars(&index, 1, &index2);
  1010.         TkTextChanged(textPtr, &index, &index2);
  1011.         if (textPtr->highlightWidth > 0) {
  1012.         TkTextRedrawRegion(textPtr, 0, 0, textPtr->highlightWidth,
  1013.             textPtr->highlightWidth);
  1014.         }
  1015.     }
  1016.     }
  1017. }
  1018.  
  1019. /*
  1020.  *----------------------------------------------------------------------
  1021.  *
  1022.  * TextCmdDeletedProc --
  1023.  *
  1024.  *    This procedure is invoked when a widget command is deleted.  If
  1025.  *    the widget isn't already in the process of being destroyed,
  1026.  *    this command destroys it.
  1027.  *
  1028.  * Results:
  1029.  *    None.
  1030.  *
  1031.  * Side effects:
  1032.  *    The widget is destroyed.
  1033.  *
  1034.  *----------------------------------------------------------------------
  1035.  */
  1036.  
  1037. static void
  1038. TextCmdDeletedProc(clientData)
  1039.     ClientData clientData;    /* Pointer to widget record for widget. */
  1040. {
  1041.     TkText *textPtr = (TkText *) clientData;
  1042.     Tk_Window tkwin = textPtr->tkwin;
  1043.  
  1044.     /*
  1045.      * This procedure could be invoked either because the window was
  1046.      * destroyed and the command was then deleted (in which case tkwin
  1047.      * is NULL) or because the command was deleted, and then this procedure
  1048.      * destroys the widget.
  1049.      */
  1050.  
  1051.     if (tkwin != NULL) {
  1052.     textPtr->tkwin = NULL;
  1053.     Tk_DestroyWindow(tkwin);
  1054.     }
  1055. }
  1056.  
  1057. /*
  1058.  *----------------------------------------------------------------------
  1059.  *
  1060.  * InsertChars --
  1061.  *
  1062.  *    This procedure implements most of the functionality of the
  1063.  *    "insert" widget command.
  1064.  *
  1065.  * Results:
  1066.  *    None.
  1067.  *
  1068.  * Side effects:
  1069.  *    The characters in "string" get added to the text just before
  1070.  *    the character indicated by "indexPtr".
  1071.  *
  1072.  *----------------------------------------------------------------------
  1073.  */
  1074.  
  1075. static void
  1076. InsertChars(textPtr, indexPtr, string)
  1077.     TkText *textPtr;        /* Overall information about text widget. */
  1078.     TkTextIndex *indexPtr;    /* Where to insert new characters.  May be
  1079.                  * modified and/or invalidated. */
  1080.     char *string;        /* Null-terminated string containing new
  1081.                  * information to add to text. */
  1082. {
  1083.     int lineIndex, resetView, offset;
  1084.     TkTextIndex newTop;
  1085.  
  1086.     /*
  1087.      * Don't allow insertions on the last (dummy) line of the text.
  1088.      */
  1089.  
  1090.     lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
  1091.     if (lineIndex == TkBTreeNumLines(textPtr->tree)) {
  1092.     lineIndex--;
  1093.     TkTextMakeIndex(textPtr->tree, lineIndex, 1000000, indexPtr);
  1094.     }
  1095.  
  1096.     /*
  1097.      * Notify the display module that lines are about to change, then do
  1098.      * the insertion.  If the insertion occurs on the top line of the
  1099.      * widget (textPtr->topIndex), then we have to recompute topIndex
  1100.      * after the insertion, since the insertion could invalidate it.
  1101.      */
  1102.  
  1103.     resetView = offset = 0;
  1104.     if (indexPtr->linePtr == textPtr->topIndex.linePtr) {
  1105.     resetView = 1;
  1106.     offset = textPtr->topIndex.charIndex;
  1107.     if (offset > indexPtr->charIndex) {
  1108.         offset += strlen(string);
  1109.     }
  1110.     }
  1111.     TkTextChanged(textPtr, indexPtr, indexPtr);
  1112.     TkBTreeInsertChars(indexPtr, string);
  1113.     if (resetView) {
  1114.     TkTextMakeIndex(textPtr->tree, lineIndex, 0, &newTop);
  1115.     TkTextIndexForwChars(&newTop, offset, &newTop);
  1116.     TkTextSetYView(textPtr, &newTop, 0);
  1117.     }
  1118.  
  1119.     /*
  1120.      * Invalidate any selection retrievals in progress.
  1121.      */
  1122.  
  1123.     textPtr->abortSelections = 1;
  1124. }
  1125.  
  1126. /*
  1127.  *----------------------------------------------------------------------
  1128.  *
  1129.  * DeleteChars --
  1130.  *
  1131.  *    This procedure implements most of the functionality of the
  1132.  *    "delete" widget command.
  1133.  *
  1134.  * Results:
  1135.  *    Returns a standard Tcl result, and leaves an error message
  1136.  *    in textPtr->interp if there is an error.
  1137.  *
  1138.  * Side effects:
  1139.  *    Characters get deleted from the text.
  1140.  *
  1141.  *----------------------------------------------------------------------
  1142.  */
  1143.  
  1144. static int
  1145. DeleteChars(textPtr, index1String, index2String)
  1146.     TkText *textPtr;        /* Overall information about text widget. */
  1147.     char *index1String;        /* String describing location of first
  1148.                  * character to delete. */
  1149.     char *index2String;        /* String describing location of last
  1150.                  * character to delete.  NULL means just
  1151.                  * delete the one character given by
  1152.                  * index1String. */
  1153. {
  1154.     int line1, line2, line, charIndex, resetView;
  1155.     TkTextIndex index1, index2;
  1156.  
  1157.     /*
  1158.      * Parse the starting and stopping indices.
  1159.      */
  1160.  
  1161.     if (TkTextGetIndex(textPtr->interp, textPtr, index1String, &index1)
  1162.         != TCL_OK) {
  1163.     return TCL_ERROR;
  1164.     }
  1165.     if (index2String != NULL) {
  1166.     if (TkTextGetIndex(textPtr->interp, textPtr, index2String, &index2)
  1167.         != TCL_OK) {
  1168.         return TCL_ERROR;
  1169.     }
  1170.     } else {
  1171.     index2 = index1;
  1172.     TkTextIndexForwChars(&index2, 1, &index2);
  1173.     }
  1174.  
  1175.     /*
  1176.      * Make sure there's really something to delete.
  1177.      */
  1178.  
  1179.     if (TkTextIndexCmp(&index1, &index2) >= 0) {
  1180.     return TCL_OK;
  1181.     }
  1182.  
  1183.     /*
  1184.      * The code below is ugly, but it's needed to make sure there
  1185.      * is always a dummy empty line at the end of the text.  If the
  1186.      * final newline of the file (just before the dummy line) is being
  1187.      * deleted, then back up index to just before the newline.  If
  1188.      * there is a newline just before the first character being deleted,
  1189.      * then back up the first index too, so that an even number of lines
  1190.      * gets deleted.  Furthermore, remove any tags that are present on
  1191.      * the newline that isn't going to be deleted after all (this simulates
  1192.      * deleting the newline and then adding a "clean" one back again).
  1193.      */
  1194.  
  1195.     line1 = TkBTreeLineIndex(index1.linePtr);
  1196.     line2 = TkBTreeLineIndex(index2.linePtr);
  1197.     if (line2 == TkBTreeNumLines(textPtr->tree)) {
  1198.     TkTextTag **arrayPtr;
  1199.     int arraySize, i;
  1200.     TkTextIndex oldIndex2;
  1201.  
  1202.     oldIndex2 = index2;
  1203.     TkTextIndexBackChars(&oldIndex2, 1, &index2);
  1204.     line2--;
  1205.     if ((index1.charIndex == 0) && (line1 != 0)) {
  1206.         TkTextIndexBackChars(&index1, 1, &index1);
  1207.         line1--;
  1208.     }
  1209.     arrayPtr = TkBTreeGetTags(&index2, &arraySize);
  1210.     if (arrayPtr != NULL) {
  1211.         for (i = 0; i < arraySize; i++) {
  1212.         TkBTreeTag(&index2, &oldIndex2, arrayPtr[i], 0);
  1213.         }
  1214.         ckfree((char *) arrayPtr);
  1215.     }
  1216.     }
  1217.  
  1218.     /*
  1219.      * Tell the display what's about to happen so it can discard
  1220.      * obsolete display information, then do the deletion.  Also,
  1221.      * if the deletion involves the top line on the screen, then
  1222.      * we have to reset the view (the deletion will invalidate
  1223.      * textPtr->topIndex).  Compute what the new first character
  1224.      * will be, then do the deletion, then reset the view.
  1225.      */
  1226.  
  1227.     TkTextChanged(textPtr, &index1, &index2);
  1228.     resetView = line = charIndex = 0;
  1229.     if (TkTextIndexCmp(&index2, &textPtr->topIndex) >= 0) {
  1230.     if (TkTextIndexCmp(&index1, &textPtr->topIndex) <= 0) {
  1231.         /*
  1232.          * Deletion range straddles topIndex: use the beginning
  1233.          * of the range as the new topIndex.
  1234.          */
  1235.  
  1236.         resetView = 1;
  1237.         line = line1;
  1238.         charIndex = index1.charIndex;
  1239.     } else if (index1.linePtr == textPtr->topIndex.linePtr) {
  1240.         /*
  1241.          * Deletion range starts on top line but after topIndex.
  1242.          * Use the current topIndex as the new one.
  1243.          */
  1244.  
  1245.         resetView = 1;
  1246.         line = line1;
  1247.         charIndex = textPtr->topIndex.charIndex;
  1248.     }
  1249.     } else if (index2.linePtr == textPtr->topIndex.linePtr) {
  1250.     /*
  1251.      * Deletion range ends on top line but before topIndex.
  1252.      * Figure out what will be the new character index for
  1253.      * the character currently pointed to by topIndex.
  1254.      */
  1255.  
  1256.     resetView = 1;
  1257.     line = line2;
  1258.     charIndex = textPtr->topIndex.charIndex;
  1259.     if (index1.linePtr != index2.linePtr) {
  1260.         charIndex -= index2.charIndex;
  1261.     } else {
  1262.         charIndex -= (index2.charIndex - index1.charIndex);
  1263.     }
  1264.     }
  1265.     TkBTreeDeleteChars(&index1, &index2);
  1266.     if (resetView) {
  1267.     TkTextMakeIndex(textPtr->tree, line, charIndex, &index1);
  1268.     TkTextSetYView(textPtr, &index1, 0);
  1269.     }
  1270.  
  1271.     /*
  1272.      * Invalidate any selection retrievals in progress.
  1273.      */
  1274.  
  1275.     textPtr->abortSelections = 1;
  1276.  
  1277.     return TCL_OK;
  1278. }
  1279.  
  1280. /*
  1281.  *----------------------------------------------------------------------
  1282.  *
  1283.  * TextFetchSelection --
  1284.  *
  1285.  *    This procedure is called back by Tk when the selection is
  1286.  *    requested by someone.  It returns part or all of the selection
  1287.  *    in a buffer provided by the caller.
  1288.  *
  1289.  * Results:
  1290.  *    The return value is the number of non-NULL bytes stored
  1291.  *    at buffer.  Buffer is filled (or partially filled) with a
  1292.  *    NULL-terminated string containing part or all of the selection,
  1293.  *    as given by offset and maxBytes.
  1294.  *
  1295.  * Side effects:
  1296.  *    None.
  1297.  *
  1298.  *----------------------------------------------------------------------
  1299.  */
  1300.  
  1301. static int
  1302. TextFetchSelection(clientData, offset, buffer, maxBytes)
  1303.     ClientData clientData;        /* Information about text widget. */
  1304.     int offset;                /* Offset within selection of first
  1305.                      * character to be returned. */
  1306.     char *buffer;            /* Location in which to place
  1307.                      * selection. */
  1308.     int maxBytes;            /* Maximum number of bytes to place
  1309.                      * at buffer, not including terminating
  1310.                      * NULL character. */
  1311. {
  1312.     register TkText *textPtr = (TkText *) clientData;
  1313.     TkTextIndex eof;
  1314.     int count, chunkSize, offsetInSeg;
  1315.     TkTextSearch search;
  1316.     TkTextSegment *segPtr;
  1317.  
  1318.     if (!textPtr->exportSelection) {
  1319.     return -1;
  1320.     }
  1321.  
  1322.     /*
  1323.      * Find the beginning of the next range of selected text.  Note:  if
  1324.      * the selection is being retrieved in multiple pieces (offset != 0)
  1325.      * and some modification has been made to the text that affects the
  1326.      * selection then reject the selection request (make 'em start over
  1327.      * again).
  1328.      */
  1329.  
  1330.     if (offset == 0) {
  1331.     TkTextMakeIndex(textPtr->tree, 0, 0, &textPtr->selIndex);
  1332.     textPtr->abortSelections = 0;
  1333.     } else if (textPtr->abortSelections) {
  1334.     return 0;
  1335.     }
  1336.     TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &eof);
  1337.     TkBTreeStartSearch(&textPtr->selIndex, &eof, textPtr->selTagPtr, &search);
  1338.     if (!TkBTreeCharTagged(&textPtr->selIndex, textPtr->selTagPtr)) {
  1339.     if (!TkBTreeNextTag(&search)) {
  1340.         if (offset == 0) {
  1341.         return -1;
  1342.         } else {
  1343.         return 0;
  1344.         }
  1345.     }
  1346.     textPtr->selIndex = search.curIndex;
  1347.     }
  1348.  
  1349.     /*
  1350.      * Each iteration through the outer loop below scans one selected range.
  1351.      * Each iteration through the inner loop scans one segment in the
  1352.      * selected range.
  1353.      */
  1354.  
  1355.     count = 0;
  1356.     while (1) {
  1357.     /*
  1358.      * Find the end of the current range of selected text.
  1359.      */
  1360.  
  1361.     if (!TkBTreeNextTag(&search)) {
  1362.         panic("TextFetchSelection couldn't find end of range");
  1363.     }
  1364.  
  1365.     /*
  1366.      * Copy information from character segments into the buffer
  1367.      * until either we run out of space in the buffer or we get
  1368.      * to the end of this range of text.
  1369.      */
  1370.  
  1371.     while (1) {
  1372.         if (maxBytes == 0) {
  1373.         goto done;
  1374.         }
  1375.         segPtr = TkTextIndexToSeg(&textPtr->selIndex, &offsetInSeg);
  1376.         chunkSize = segPtr->size - offsetInSeg;
  1377.         if (chunkSize > maxBytes) {
  1378.         chunkSize = maxBytes;
  1379.         }
  1380.         if (textPtr->selIndex.linePtr == search.curIndex.linePtr) {
  1381.         int leftInRange;
  1382.  
  1383.         leftInRange = search.curIndex.charIndex
  1384.             - textPtr->selIndex.charIndex;
  1385.         if (leftInRange < chunkSize) {
  1386.             chunkSize = leftInRange;
  1387.             if (chunkSize <= 0) {
  1388.             break;
  1389.             }
  1390.         }
  1391.         }
  1392.         if (segPtr->typePtr == &tkTextCharType) {
  1393.         memcpy((VOID *) buffer, (VOID *) (segPtr->body.chars
  1394.             + offsetInSeg), (size_t) chunkSize);
  1395.         buffer += chunkSize;
  1396.         maxBytes -= chunkSize;
  1397.         count += chunkSize;
  1398.         }
  1399.         TkTextIndexForwChars(&textPtr->selIndex, chunkSize,
  1400.             &textPtr->selIndex);
  1401.     }
  1402.  
  1403.     /*
  1404.      * Find the beginning of the next range of selected text.
  1405.      */
  1406.  
  1407.     if (!TkBTreeNextTag(&search)) {
  1408.         break;
  1409.     }
  1410.     textPtr->selIndex = search.curIndex;
  1411.     }
  1412.  
  1413.     done:
  1414.     *buffer = 0;
  1415.     return count;
  1416. }
  1417.  
  1418. /*
  1419.  *----------------------------------------------------------------------
  1420.  *
  1421.  * TkTextLostSelection --
  1422.  *
  1423.  *    This procedure is called back by Tk when the selection is
  1424.  *    grabbed away from a text widget.
  1425.  *
  1426.  * Results:
  1427.  *    None.
  1428.  *
  1429.  * Side effects:
  1430.  *    The "sel" tag is cleared from the window.
  1431.  *
  1432.  *----------------------------------------------------------------------
  1433.  */
  1434.  
  1435. void
  1436. TkTextLostSelection(clientData)
  1437.     ClientData clientData;        /* Information about text widget. */
  1438. {
  1439.     register TkText *textPtr = (TkText *) clientData;
  1440.     TkTextIndex start, end;
  1441.  
  1442.     if (!textPtr->exportSelection) {
  1443.     return;
  1444.     }
  1445.  
  1446.     /*
  1447.      * Just remove the "sel" tag from everything in the widget.
  1448.      */
  1449.  
  1450.     TkTextMakeIndex(textPtr->tree, 0, 0, &start);
  1451.     TkTextMakeIndex(textPtr->tree, TkBTreeNumLines(textPtr->tree), 0, &end);
  1452.     TkTextRedrawTag(textPtr, &start, &end, textPtr->selTagPtr, 1);
  1453.     TkBTreeTag(&start, &end, textPtr->selTagPtr, 0);
  1454.     textPtr->flags &= ~GOT_SELECTION;
  1455. }
  1456.  
  1457. /*
  1458.  *----------------------------------------------------------------------
  1459.  *
  1460.  * TextBlinkProc --
  1461.  *
  1462.  *    This procedure is called as a timer handler to blink the
  1463.  *    insertion cursor off and on.
  1464.  *
  1465.  * Results:
  1466.  *    None.
  1467.  *
  1468.  * Side effects:
  1469.  *    The cursor gets turned on or off, redisplay gets invoked,
  1470.  *    and this procedure reschedules itself.
  1471.  *
  1472.  *----------------------------------------------------------------------
  1473.  */
  1474.  
  1475. static void
  1476. TextBlinkProc(clientData)
  1477.     ClientData clientData;    /* Pointer to record describing text. */
  1478. {
  1479.     register TkText *textPtr = (TkText *) clientData;
  1480.     TkTextIndex index, index2;
  1481.  
  1482.     if (!(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) {
  1483.     return;
  1484.     }
  1485.     if (textPtr->flags & INSERT_ON) {
  1486.     textPtr->flags &= ~INSERT_ON;
  1487.     textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
  1488.         textPtr->insertOffTime, TextBlinkProc, (ClientData) textPtr);
  1489.     } else {
  1490.     textPtr->flags |= INSERT_ON;
  1491.     textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
  1492.         textPtr->insertOnTime, TextBlinkProc, (ClientData) textPtr);
  1493.     }
  1494.     TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
  1495.     TkTextIndexForwChars(&index, 1, &index2);
  1496.     TkTextChanged(textPtr, &index, &index2);
  1497. }
  1498.  
  1499. /*
  1500.  *----------------------------------------------------------------------
  1501.  *
  1502.  * TextSearchCmd --
  1503.  *
  1504.  *    This procedure is invoked to process the "search" widget command
  1505.  *    for text widgets.  See the user documentation for details on what
  1506.  *    it does.
  1507.  *
  1508.  * Results:
  1509.  *    A standard Tcl result.
  1510.  *
  1511.  * Side effects:
  1512.  *    See the user documentation.
  1513.  *
  1514.  *----------------------------------------------------------------------
  1515.  */
  1516.  
  1517. static int
  1518. TextSearchCmd(textPtr, interp, argc, argv)
  1519.     TkText *textPtr;        /* Information about text widget. */
  1520.     Tcl_Interp *interp;        /* Current interpreter. */
  1521.     int argc;            /* Number of arguments. */
  1522.     char **argv;        /* Argument strings. */
  1523. {
  1524.     int backwards, exact, c, i, argsLeft, noCase, leftToScan;
  1525.     size_t length;
  1526.     int numLines, startingLine, startingChar, lineNum, firstChar, lastChar;
  1527.     int code, matchLength, matchChar, passes, stopLine, searchWholeText;
  1528.     int patLength;
  1529.     char *arg, *pattern, *varName, *p, *startOfLine;
  1530.     char buffer[20];
  1531.     TkTextIndex index, stopIndex;
  1532.     Tcl_DString line, patDString;
  1533.     TkTextSegment *segPtr;
  1534.     TkTextLine *linePtr;
  1535.     Tcl_RegExp regexp = NULL;        /* Initialization needed only to
  1536.                      * prevent compiler warning. */
  1537.  
  1538.     /*
  1539.      * Parse switches and other arguments.
  1540.      */
  1541.  
  1542.     exact = 1;
  1543.     backwards = 0;
  1544.     noCase = 0;
  1545.     varName = NULL;
  1546.     for (i = 2; i < argc; i++) {
  1547.     arg = argv[i];
  1548.     if (arg[0] != '-') {
  1549.         break;
  1550.     }
  1551.     length = strlen(arg);
  1552.     if (length < 2) {
  1553.         badSwitch:
  1554.         Tcl_AppendResult(interp, "bad switch \"", arg,
  1555. #ifdef STk_CODE
  1556.             "\": must be -forward, :backward, :exact, :regexp, ",
  1557.             ":nocase, :count, or ::", (char *) NULL);
  1558. #else
  1559.             "\": must be -forward, -backward, -exact, -regexp, ",
  1560.             "-nocase, -count, or --", (char *) NULL);
  1561. #endif
  1562.         return TCL_ERROR;
  1563.     }
  1564.     c = arg[1];
  1565.     if ((c == 'b') && (strncmp(argv[i], "-backwards", length) == 0)) {
  1566.         backwards = 1;
  1567.     } else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0)) {
  1568.         if (i >= (argc-1)) {
  1569.         interp->result = "no value given for \"-count\" option";
  1570.         return TCL_ERROR;
  1571.         }
  1572.         i++;
  1573.         varName = argv[i];
  1574.     } else if ((c == 'e') && (strncmp(argv[i], "-exact", length) == 0)) {
  1575.         exact = 1;
  1576.     } else if ((c == 'f') && (strncmp(argv[i], "-forwards", length) == 0)) {
  1577.         backwards = 0;
  1578.     } else if ((c == 'n') && (strncmp(argv[i], "-nocase", length) == 0)) {
  1579.         noCase = 1;
  1580.     } else if ((c == 'r') && (strncmp(argv[i], "-regexp", length) == 0)) {
  1581.         exact = 0;
  1582.     } else if ((c == '-') && (strncmp(argv[i], "--", length) == 0)) {
  1583.         i++;
  1584.         break;
  1585.     } else {
  1586.         goto badSwitch;
  1587.     }
  1588.     }
  1589.     argsLeft = argc - (i+2);
  1590.     if ((argsLeft != 0) && (argsLeft != 1)) {
  1591.     Tcl_AppendResult(interp, "wrong # args: should be \"",
  1592.         argv[0], " search ?switches? pattern index ?stopIndex?",
  1593.         (char *) NULL);
  1594.     return TCL_ERROR;
  1595.     }
  1596.     pattern = argv[i];
  1597.  
  1598.     /*
  1599.      * Convert the pattern to lower-case if we're supposed to ignore case.
  1600.      */
  1601.  
  1602.     if (noCase) {
  1603.     Tcl_DStringInit(&patDString);
  1604.     Tcl_DStringAppend(&patDString, pattern, -1);
  1605.     pattern = Tcl_DStringValue(&patDString);
  1606.     for (p = pattern; *p != 0; p++) {
  1607.         if (isupper(UCHAR(*p))) {
  1608.         *p = tolower(UCHAR(*p));
  1609.         }
  1610.     }
  1611.     }
  1612.  
  1613.     if (TkTextGetIndex(interp, textPtr, argv[i+1], &index) != TCL_OK) {
  1614.     return TCL_ERROR;
  1615.     }
  1616.     numLines = TkBTreeNumLines(textPtr->tree);
  1617.     startingLine = TkBTreeLineIndex(index.linePtr);
  1618.     startingChar = index.charIndex;
  1619.     if (startingLine >= numLines) {
  1620.     if (backwards) {
  1621.         startingLine = TkBTreeNumLines(textPtr->tree) - 1;
  1622.         startingChar = TkBTreeCharsInLine(TkBTreeFindLine(textPtr->tree,
  1623.             startingLine));
  1624.     } else {
  1625.         startingLine = 0;
  1626.         startingChar = 0;
  1627.     }
  1628.     }
  1629.     if (argsLeft == 1) {
  1630.     if (TkTextGetIndex(interp, textPtr, argv[i+2], &stopIndex) != TCL_OK) {
  1631.         return TCL_ERROR;
  1632.     }
  1633.     stopLine = TkBTreeLineIndex(stopIndex.linePtr);
  1634.     if (!backwards && (stopLine == numLines)) {
  1635.         stopLine = numLines-1;
  1636.     }
  1637.     searchWholeText = 0;
  1638.     } else {
  1639.     stopLine = 0;
  1640.     searchWholeText = 1;
  1641.     }
  1642.  
  1643.     /*
  1644.      * Scan through all of the lines of the text circularly, starting
  1645.      * at the given index.
  1646.      */
  1647.  
  1648.     matchLength = patLength = 0;    /* Only needed to prevent compiler
  1649.                      * warnings. */
  1650.     if (exact) {
  1651.     patLength = strlen(pattern);
  1652.     } else {
  1653.     regexp = Tcl_RegExpCompile(interp, pattern);
  1654.     if (regexp == NULL) {
  1655.         return TCL_ERROR;
  1656.     }
  1657.     }
  1658.     lineNum = startingLine;
  1659.     code = TCL_OK;
  1660.     Tcl_DStringInit(&line);
  1661.     for (passes = 0; passes < 2; ) {
  1662.     if (lineNum >= numLines) {
  1663.         /*
  1664.          * Don't search the dummy last line of the text.
  1665.          */
  1666.  
  1667.         goto nextLine;
  1668.     }
  1669.  
  1670.     /*
  1671.      * Extract the text from the line.  If we're doing regular
  1672.      * expression matching, drop the newline from the line, so
  1673.      * that "$" can be used to match the end of the line.
  1674.      */
  1675.  
  1676.     linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
  1677.     for (segPtr = linePtr->segPtr; segPtr != NULL;
  1678.         segPtr = segPtr->nextPtr) {
  1679.         if (segPtr->typePtr != &tkTextCharType) {
  1680.         continue;
  1681.         }
  1682.         Tcl_DStringAppend(&line, segPtr->body.chars, segPtr->size);
  1683.     }
  1684.     if (!exact) {
  1685.         Tcl_DStringSetLength(&line, Tcl_DStringLength(&line)-1);
  1686.     }
  1687.     startOfLine = Tcl_DStringValue(&line);
  1688.  
  1689.     /*
  1690.      * If we're ignoring case, convert the line to lower case.
  1691.      */
  1692.  
  1693.     if (noCase) {
  1694.         for (p = Tcl_DStringValue(&line); *p != 0; p++) {
  1695.         if (isupper(UCHAR(*p))) {
  1696.             *p = tolower(UCHAR(*p));
  1697.         }
  1698.         }
  1699.     }
  1700.  
  1701.     /*
  1702.      * Check for matches within the current line.  If so, and if we're
  1703.      * searching backwards, repeat the search to find the last match
  1704.      * in the line.
  1705.      */
  1706.  
  1707.     matchChar = -1;
  1708.     firstChar = 0;
  1709.     lastChar = INT_MAX;
  1710.     if (lineNum == startingLine) {
  1711.         int indexInDString;
  1712.  
  1713.         /*
  1714.          * The starting line is tricky: the first time we see it
  1715.          * we check one part of the line, and the second pass through
  1716.          * we check the other part of the line.  We have to be very
  1717.          * careful here because there could be embedded windows or
  1718.          * other things that are not in the extracted line.  Rescan
  1719.          * the original line to compute the index in it of the first
  1720.          * character.
  1721.          */
  1722.  
  1723.         indexInDString = startingChar;
  1724.         for (segPtr = linePtr->segPtr, leftToScan = startingChar;
  1725.             leftToScan > 0; segPtr = segPtr->nextPtr) {
  1726.         if (segPtr->typePtr != &tkTextCharType) {
  1727.             indexInDString -= segPtr->size;
  1728.         }
  1729.         leftToScan -= segPtr->size;
  1730.         }
  1731.  
  1732.         passes++;
  1733.         if ((passes == 1) ^ backwards) {
  1734.         /*
  1735.          * Only use the last part of the line.
  1736.          */
  1737.  
  1738.         firstChar = indexInDString;
  1739.         if (firstChar >= Tcl_DStringLength(&line)) {
  1740.             goto nextLine;
  1741.         }
  1742.         } else {
  1743.         /*
  1744.          * Use only the first part of the line.
  1745.          */
  1746.  
  1747.         lastChar = indexInDString;
  1748.         }
  1749.     }
  1750.     do {
  1751.         int thisLength;
  1752.         if (exact) {
  1753.         p = strstr(startOfLine + firstChar, pattern);
  1754.         if (p == NULL) {
  1755.             break;
  1756.         }
  1757.         i = p - startOfLine;
  1758.         thisLength = patLength;
  1759.         } else {
  1760.         char *start, *end;
  1761.         int match;
  1762.  
  1763.         match = Tcl_RegExpExec(interp, regexp,
  1764.             startOfLine + firstChar, startOfLine);
  1765.         if (match < 0) {
  1766.             code = TCL_ERROR;
  1767.             goto done;
  1768.         }
  1769.         if (!match) {
  1770.             break;
  1771.         }
  1772.         Tcl_RegExpRange(regexp, 0, &start, &end);
  1773.         i = start - startOfLine;
  1774.         thisLength = end - start;
  1775.         }
  1776.         if (i >= lastChar) {
  1777.         break;
  1778.         }
  1779.         matchChar = i;
  1780.         matchLength = thisLength;
  1781.         firstChar = matchChar+1;
  1782.     } while (backwards);
  1783.  
  1784.     /*
  1785.      * If we found a match then we're done.  Make sure that
  1786.      * the match occurred before the stopping index, if one was
  1787.      * specified.
  1788.      */
  1789.  
  1790.     if (matchChar >= 0) {
  1791.         /*
  1792.          * The index information returned by the regular expression
  1793.          * parser only considers textual information:  it doesn't
  1794.          * account for embedded windows or any other non-textual info.
  1795.          * Scan through the line's segments again to adjust both
  1796.          * matchChar and matchCount.
  1797.          */
  1798.  
  1799.         for (segPtr = linePtr->segPtr, leftToScan = matchChar;
  1800.             leftToScan >= 0; segPtr = segPtr->nextPtr) {
  1801.         if (segPtr->typePtr != &tkTextCharType) {
  1802.             matchChar += segPtr->size;
  1803.             continue;
  1804.         }
  1805.         leftToScan -= segPtr->size;
  1806.         }
  1807.         for (leftToScan += matchLength; leftToScan > 0;
  1808.             segPtr = segPtr->nextPtr) {
  1809.         if (segPtr->typePtr != &tkTextCharType) {
  1810.             matchLength += segPtr->size;
  1811.             continue;
  1812.         }
  1813.         leftToScan -= segPtr->size;
  1814.         }
  1815.         TkTextMakeIndex(textPtr->tree, lineNum, matchChar, &index);
  1816.         if (!searchWholeText) {
  1817.         if (!backwards && (TkTextIndexCmp(&index, &stopIndex) >= 0)) {
  1818.             goto done;
  1819.         }
  1820.         if (backwards && (TkTextIndexCmp(&index, &stopIndex) < 0)) {
  1821.             goto done;
  1822.         }
  1823.         }
  1824.         if (varName != NULL) {
  1825.         sprintf(buffer, "%d", matchLength);
  1826.         if (Tcl_SetVar(interp, varName, buffer, TCL_LEAVE_ERR_MSG)
  1827.             == NULL) {
  1828.             code = TCL_ERROR;
  1829.             goto done;
  1830.         }
  1831.         }
  1832.         TkTextPrintIndex(&index, interp->result);
  1833.         goto done;
  1834.     }
  1835.  
  1836.     /*
  1837.      * Go to the next (or previous) line;
  1838.      */
  1839.  
  1840.     nextLine:
  1841.     if (backwards) {
  1842.         lineNum--;
  1843.         if (!searchWholeText) {
  1844.         if (lineNum < stopLine) {
  1845.             break;
  1846.         }
  1847.         } else if (lineNum < 0) {
  1848.         lineNum = numLines-1;
  1849.         }
  1850.     } else {
  1851.         lineNum++;
  1852.         if (!searchWholeText) {
  1853.         if (lineNum > stopLine) {
  1854.             break;
  1855.         }
  1856.         } else if (lineNum >= numLines) {
  1857.         lineNum = 0;
  1858.         }
  1859.     }
  1860.     Tcl_DStringSetLength(&line, 0);
  1861.     }
  1862.     done:
  1863. #ifdef STk_CODE
  1864.     if (*interp->result == '\0') {
  1865.       /* No match ==> return #f */
  1866.       interp->result = "#f";
  1867.     }
  1868. #endif
  1869.     Tcl_DStringFree(&line);
  1870.     if (noCase) {
  1871.     Tcl_DStringFree(&patDString);
  1872.     }
  1873.     return code;
  1874. }
  1875.  
  1876. /*
  1877.  *----------------------------------------------------------------------
  1878.  *
  1879.  * TkTextGetTabs --
  1880.  *
  1881.  *    Parses a string description of a set of tab stops.
  1882.  *
  1883.  * Results:
  1884.  *    The return value is a pointer to a malloc'ed structure holding
  1885.  *    parsed information about the tab stops.  If an error occurred
  1886.  *    then the return value is NULL and an error message is left in
  1887.  *    interp->result.
  1888.  *
  1889.  * Side effects:
  1890.  *    Memory is allocated for the structure that is returned.  It is
  1891.  *    up to the caller to free this structure when it is no longer
  1892.  *    needed.
  1893.  *
  1894.  *----------------------------------------------------------------------
  1895.  */
  1896.  
  1897. TkTextTabArray *
  1898. TkTextGetTabs(interp, tkwin, string)
  1899.     Tcl_Interp *interp;            /* Used for error reporting. */
  1900.     Tk_Window tkwin;            /* Window in which the tabs will be
  1901.                      * used. */
  1902.     char *string;            /* Description of the tab stops.  See
  1903.                      * the text manual entry for details. */
  1904. {
  1905.     int argc, i, count, c;
  1906.     char **argv;
  1907.     TkTextTabArray *tabArrayPtr;
  1908.     TkTextTab *tabPtr;
  1909.  
  1910.     if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
  1911.     return NULL;
  1912.     }
  1913.  
  1914.     /*
  1915.      * First find out how many entries we need to allocate in the
  1916.      * tab array.
  1917.      */
  1918.  
  1919.     count = 0;
  1920.     for (i = 0; i < argc; i++) {
  1921.     c = argv[i][0];
  1922.     if ((c != 'l') && (c != 'r') && (c != 'c') && (c != 'n')) {
  1923.         count++;
  1924.     }
  1925.     }
  1926.  
  1927.     /*
  1928.      * Parse the elements of the list one at a time to fill in the
  1929.      * array.
  1930.      */
  1931.  
  1932.     tabArrayPtr = (TkTextTabArray *) ckalloc((unsigned)
  1933.         (sizeof(TkTextTabArray) + (count-1)*sizeof(TkTextTab)));
  1934.     tabArrayPtr->numTabs = 0;
  1935.     for (i = 0, tabPtr = &tabArrayPtr->tabs[0]; i  < argc; i++, tabPtr++) {
  1936.     if (Tk_GetPixels(interp, tkwin, argv[i], &tabPtr->location)
  1937.         != TCL_OK) {
  1938.         goto error;
  1939.     }
  1940.     tabArrayPtr->numTabs++;
  1941.  
  1942.     /*
  1943.      * See if there is an explicit alignment in the next list
  1944.      * element.  Otherwise just use "left".
  1945.      */
  1946.  
  1947.     tabPtr->alignment = LEFT;
  1948.     if ((i+1) == argc) {
  1949.         continue;
  1950.     }
  1951.     c = UCHAR(argv[i+1][0]);
  1952.     if (!isalpha(c)) {
  1953.         continue;
  1954.     }
  1955.     i += 1;
  1956.     if ((c == 'l') && (strncmp(argv[i], "left",
  1957.         strlen(argv[i])) == 0)) {
  1958.         tabPtr->alignment = LEFT;
  1959.     } else if ((c == 'r') && (strncmp(argv[i], "right",
  1960.         strlen(argv[i])) == 0)) {
  1961.         tabPtr->alignment = RIGHT;
  1962.     } else if ((c == 'c') && (strncmp(argv[i], "center",
  1963.         strlen(argv[i])) == 0)) {
  1964.         tabPtr->alignment = CENTER;
  1965.     } else if ((c == 'n') && (strncmp(argv[i],
  1966.         "numeric", strlen(argv[i])) == 0)) {
  1967.         tabPtr->alignment = NUMERIC;
  1968.     } else {
  1969.         Tcl_AppendResult(interp, "bad tab alignment \"",
  1970.             argv[i], "\": must be left, right, center, or numeric",
  1971.             (char *) NULL);
  1972.         goto error;
  1973.     }
  1974.     }
  1975.     ckfree((char *) argv);
  1976.     return tabArrayPtr;
  1977.  
  1978.     error:
  1979.     ckfree((char *) tabArrayPtr);
  1980.     ckfree((char *) argv);
  1981.     return NULL;
  1982. }
  1983.  
  1984. /*
  1985.  *----------------------------------------------------------------------
  1986.  *
  1987.  * TextDumpCmd --
  1988.  *
  1989.  *    Return information about the text, tags, marks, and embedded windows
  1990.  *    in a text widget.  See the man page for the description of the
  1991.  *    text dump operation for all the details.
  1992.  *
  1993.  * Results:
  1994.  *    A standard Tcl result.
  1995.  *
  1996.  * Side effects:
  1997.  *    Memory is allocated for the result, if needed (standard Tcl result
  1998.  *    side effects).
  1999.  *
  2000.  *----------------------------------------------------------------------
  2001.  */
  2002.  
  2003. static int
  2004. TextDumpCmd(textPtr, interp, argc, argv)
  2005.     register TkText *textPtr;    /* Information about text widget. */
  2006.     Tcl_Interp *interp;        /* Current interpreter. */
  2007.     int argc;            /* Number of arguments. */
  2008.     char **argv;        /* Argument strings.  Someone else has already
  2009.                  * parsed this command enough to know that
  2010.                  * argv[1] is "dump". */
  2011. {
  2012.     TkTextIndex index1, index2;
  2013.     int arg;
  2014.     int lineno;            /* Current line number */
  2015.     int what = 0;        /* bitfield to select segment types */
  2016.     int atEnd;            /* True if dumping up to logical end */
  2017.     TkTextLine *linePtr;
  2018.     char *command = NULL;    /* Script callback to apply to segments */
  2019. #define TK_DUMP_TEXT    0x1
  2020. #define TK_DUMP_MARK    0x2
  2021. #define TK_DUMP_TAG    0x4
  2022. #define TK_DUMP_WIN    0x8
  2023. #define TK_DUMP_ALL    (TK_DUMP_TEXT|TK_DUMP_MARK|TK_DUMP_TAG|TK_DUMP_WIN)
  2024.  
  2025.     for (arg=2 ; argv[arg] != (char *) NULL ; arg++) {
  2026.     size_t len;
  2027.     if (argv[arg][0] != '-') {
  2028.         break;
  2029.     }
  2030.     len = strlen(argv[arg]);
  2031.     if (strncmp("-all", argv[arg], len) == 0) {
  2032.         what = TK_DUMP_ALL;
  2033.     } else if (strncmp("-text", argv[arg], len) == 0) {
  2034.         what |= TK_DUMP_TEXT;
  2035.     } else if (strncmp("-tag", argv[arg], len) == 0) {
  2036.         what |= TK_DUMP_TAG;
  2037.     } else if (strncmp("-mark", argv[arg], len) == 0) {
  2038.         what |= TK_DUMP_MARK;
  2039.     } else if (strncmp("-window", argv[arg], len) == 0) {
  2040.         what |= TK_DUMP_WIN;
  2041.     } else if (strncmp("-command", argv[arg], len) == 0) {
  2042.         arg++;
  2043.         if (arg >= argc) {
  2044.         Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -text -mark -tag -window? ?-command script? index ?index2?", NULL);
  2045.         return TCL_ERROR;
  2046.         }
  2047.         command = argv[arg];
  2048.     } else {
  2049.         Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -text -mark -tag -window? ?-command script? index ?index2?", NULL);
  2050.         return TCL_ERROR;
  2051.     }
  2052.     }
  2053.     if (arg >= argc) {
  2054.     Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -text -mark -tag -window? ?-command script? index ?index2?", NULL);
  2055.     return TCL_ERROR;
  2056.     }
  2057.     if (what == 0) {
  2058.     what = TK_DUMP_ALL;
  2059.     }
  2060.     if (TkTextGetIndex(interp, textPtr, argv[arg], &index1) != TCL_OK) {
  2061.     return TCL_ERROR;
  2062.     }
  2063.     lineno = TkBTreeLineIndex(index1.linePtr) + 1;
  2064.     arg++;
  2065.     atEnd = 0;
  2066.     if (argc == arg) {
  2067.     TkTextIndexForwChars(&index1, 1, &index2);
  2068.     } else {
  2069.     if (TkTextGetIndex(interp, textPtr, argv[arg], &index2) != TCL_OK) {
  2070.         return TCL_ERROR;
  2071.     }
  2072.     if (strncmp(argv[arg], "end", strlen(argv[arg])) == 0) {
  2073.         atEnd = 1;
  2074.     }
  2075.     }
  2076.     if (TkTextIndexCmp(&index1, &index2) >= 0) {
  2077.     return TCL_OK;
  2078.     }
  2079.     if (index1.linePtr == index2.linePtr) {
  2080.     DumpLine(interp, textPtr, what, index1.linePtr,
  2081.         index1.charIndex, index2.charIndex, lineno, command);
  2082.     } else {
  2083.     DumpLine(interp, textPtr, what, index1.linePtr,
  2084.         index1.charIndex, 32000000, lineno, command);
  2085.     linePtr = index1.linePtr;
  2086.     while ((linePtr = TkBTreeNextLine(linePtr)) != (TkTextLine *)NULL) {
  2087.         lineno++;
  2088.         if (linePtr == index2.linePtr) {
  2089.         break;
  2090.         }
  2091.         DumpLine(interp, textPtr, what, linePtr, 0, 32000000,
  2092.             lineno, command);
  2093.     }
  2094.     DumpLine(interp, textPtr, what, index2.linePtr, 0,
  2095.         index2.charIndex, lineno, command);
  2096.     }
  2097.     /*
  2098.      * Special case to get the leftovers hiding at the end mark.
  2099.      */
  2100.     if (atEnd) {
  2101.     DumpLine(interp, textPtr, what & ~TK_DUMP_TEXT, index2.linePtr,
  2102.         0, 1, lineno, command);
  2103.  
  2104.     }
  2105.     return TCL_OK;
  2106. }
  2107.  
  2108. /*
  2109.  * DumpLine
  2110.  *     Return information about a given text line from character
  2111.  *    position "start" up to, but not including, "end".
  2112.  *
  2113.  * Results:
  2114.  *    A standard Tcl result.
  2115.  *
  2116.  * Side effects:
  2117.  *    None, but see DumpSegment.
  2118.  */
  2119. static void
  2120. DumpLine(interp, textPtr, what, linePtr, start, end, lineno, command)
  2121.     Tcl_Interp *interp;
  2122.     TkText *textPtr;
  2123.     int what;            /* bit flags to select segment types */
  2124.     TkTextLine *linePtr;    /* The current line */
  2125.     int start, end;        /* Character range to dump */
  2126.     int lineno;            /* Line number for indices dump */
  2127.     char *command;        /* Script to apply to the segment */
  2128. {
  2129.     int offset;
  2130.     TkTextSegment *segPtr;
  2131.     /*
  2132.      * Must loop through line looking at its segments.
  2133.      * character
  2134.      * toggleOn, toggleOff
  2135.      * mark
  2136.      * window
  2137.      */
  2138.     for (offset = 0, segPtr = linePtr->segPtr ;
  2139.         (offset < end) && (segPtr != (TkTextSegment *)NULL) ;
  2140.         offset += segPtr->size, segPtr = segPtr->nextPtr) {
  2141.     int result = TCL_OK;
  2142.     if ((what & TK_DUMP_TEXT) && (segPtr->typePtr == &tkTextCharType) &&
  2143.         (offset + segPtr->size > start)) {
  2144.         char savedChar;            /* Last char used in the seg */
  2145.         int last = segPtr->size;        /* Index of savedChar */
  2146.         int first = 0;            /* Index of first char in seg */
  2147.         if (offset + segPtr->size > end) {
  2148.         last = end - offset;
  2149.         }
  2150.         if (start > offset) {
  2151.         first = start - offset;
  2152.         }
  2153.         savedChar = segPtr->body.chars[last];
  2154.         segPtr->body.chars[last] = '\0';
  2155.         result = DumpSegment(interp, "text", segPtr->body.chars + first,
  2156.             command, lineno, offset + first, what);
  2157.         segPtr->body.chars[last] = savedChar;
  2158.     } else if ((offset >= start)) {
  2159.         if ((what & TK_DUMP_MARK) && (segPtr->typePtr->name[0] == 'm')) {
  2160.         TkTextMark *markPtr = (TkTextMark *)&segPtr->body;
  2161.         char *name = Tcl_GetHashKey(&textPtr->markTable, markPtr->hPtr);
  2162.         result = DumpSegment(interp, "mark", name,
  2163.             command, lineno, offset, what);
  2164.         } else if ((what & TK_DUMP_TAG) &&
  2165.             (segPtr->typePtr == &tkTextToggleOnType)) {
  2166.         result = DumpSegment(interp, "tagon",
  2167.             segPtr->body.toggle.tagPtr->name,
  2168.             command, lineno, offset, what);
  2169.         } else if ((what & TK_DUMP_TAG) && 
  2170.             (segPtr->typePtr == &tkTextToggleOffType)) {
  2171.         result = DumpSegment(interp, "tagoff",
  2172.             segPtr->body.toggle.tagPtr->name,
  2173.             command, lineno, offset, what);
  2174.         } else if ((what & TK_DUMP_WIN) && 
  2175.             (segPtr->typePtr->name[0] == 'w')) {
  2176.         TkTextEmbWindow *ewPtr = (TkTextEmbWindow *)&segPtr->body;
  2177.         char *pathname;
  2178.         if (ewPtr->tkwin == (Tk_Window) NULL) {
  2179.             pathname = "";
  2180.         } else {
  2181.             pathname = Tk_PathName(ewPtr->tkwin);
  2182.         }
  2183.         result = DumpSegment(interp, "window", pathname,
  2184.             command, lineno, offset, what);
  2185.         }
  2186.     }
  2187.     }
  2188. }
  2189.  
  2190. /*
  2191.  * DumpSegment
  2192.  *    Either append information about the current segment to the result,
  2193.  *    or make a script callback with that information as arguments.
  2194.  *
  2195.  * Results:
  2196.  *    None
  2197.  *
  2198.  * Side effects:
  2199.  *    Either evals the callback or appends elements to the result string.
  2200.  */
  2201. static int
  2202. DumpSegment(interp, key, value, command, lineno, offset, what)
  2203.     Tcl_Interp *interp;
  2204.     char *key;            /* Segment type key */
  2205.     char *value;        /* Segment value */
  2206.     char *command;        /* Script callback */
  2207.     int lineno;            /* Line number for indices dump */
  2208.     int offset;            /* Character position */
  2209.     int what;            /* Look for TK_DUMP_INDEX bit */
  2210. {
  2211.     char buffer[30];
  2212.     sprintf(buffer, "%d.%d", lineno, offset);
  2213.     if (command == (char *) NULL) {
  2214.     Tcl_AppendElement(interp, key);
  2215.     Tcl_AppendElement(interp, value);
  2216.     Tcl_AppendElement(interp, buffer);
  2217.     return TCL_OK;
  2218.     } else {
  2219.     char *argv[4];
  2220.     char *list;
  2221.     int result;
  2222.     argv[0] = key;
  2223.     argv[1] = value;
  2224.     argv[2] = buffer;
  2225.     argv[3] = (char *) NULL;
  2226.     list = Tcl_Merge(3, argv);
  2227.     result = Tcl_VarEval(interp, command, " ", list, (char *) NULL);
  2228.     ckfree(list);
  2229.     return result;
  2230.     }
  2231. }
  2232.  
  2233.